perm filename MOVIT.F4[P11,LCS]1 blob sn#570605 filedate 1981-03-09 generic text, type T, neo UTF8
C****** SUBRS  MOVIT, OUTLMT, GETPTS, GUPDAT, DELETE, STFCH,COPYIT,CPYIT
	SUBROUTINE MOVIT(RN,NP,R4,R5,R8,R9)
 	DIMENSION  NP(1),RN(1)
 	COMMON  /KJY/ NO,J
	RDIS=(R9-R8)/(R5-R4)
 	DO 1 K=1,J
       	L=NP(K)
	RA=RN(L)
   	IF(OUTLMT(R4,R5,RA))GO TO 1
	IF(R9.NE.0)RA=(RA-R4)*RDIS
	RN(L)=R8+RA
1	CONTINUE
	END
 
	FUNCTION OUTLMT(A,B,R)
C TELLS IF POINT IS WITHIN BOUNDS OF A-B (PUT THIS INTO MACRO)
	OUTLMT=-1.
	IF(R.LT.A)RETURN
	IF(R.GT.B)RETURN
	OUTLMT=0
	END
 
 	SUBROUTINE GETPTS(NN)
C NN IS FIRST ITEM TO LOOK AT
	INTEGER PWDS
	COMMON/XRN/RN(1)  /KJY/ K,J /POSI/STFF(8),JJ2
	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
	1/PTR/PWDS(1) /RINP/R(500),N(350),NP(250) /LIMIT/LIM,ITEM
	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R6,RJQ(4))
	J=0
	K=0
C J AND K ARE COUNTERS FOR N AND NP ARRAYS.
	DO 1 M=NN,ITEM
	L=PWDS(M)
	RY=RN(L+1)
	IF(R2.GE.8)GO TO 3
C >=8 MEANS LOOK AT ALL STAVES
	IF(R2.NE.RN(L+2))GO TO 1
C SKIP IF NOT RIGHT STAFF NUM.
3	IF(R6.LE.0)GO TO 9
C  CHECK CODE NUM
	IF(R6.NE.RY)GO TO 1
9	IF(OUTLMT(R4,R5,RN(L+3)))GO TO 2
C  IN LIMITS?
	CALL GUPDAT(M,L,3)
C GO PUT AWAY POINTER TO P3 OF THIS ITEM
	K=K+1
	NP(K)=L
C  NP SAVES POINTER TO P3 FOR USE IN JUSTIFY ROUTINE
2	CNT=RN(L)
C  GET THE WD CNT
	IF(RY.EQ.2)GO TO 8
C FOR 'CENTERED' RESTS
	IF(RY.LT.4)GO TO 1
	IF(RY.GT.7)GO TO 1
	IF(RY.EQ.6)GO TO 6
C  TWO-ENDED ITEM?
7	IF(CNT.GT.3)GO TO 5
	GO TO 1
6	IF(CNT.LT.8)GO TO 8
	IF(RN(L+7).LT.0)GO TO 8
	IF(RN(L+10).EQ.0)GO TO 8
	IF(RN(L+8).LE.0)GO TO 8
C IGNORE P8 IF IT IS 0 OR -
	IF(OUTLMT(R4,R5,RN(L+8)))GO TO 8
C  IN LIMITS?
	CALL GUPDAT(M,L,8)
C PUT AWAY POINTER TO P8 FOR THIS BEAM
8	IF(CNT.LT.7)GO TO 5
	 IF(RN(L+9).LE.0)GO TO 5
C  WON'T LOOK AT NEG. POS.
	IF(RY.EQ.2)GO TO 10
C   (NEW REST CENTERING)
	IF(RN(L+8).NE.0)GO TO 10
	IF(RN(L+7).GE.0)GO TO 5
C    USE R9 IF R9<0 AND (R8≠0 OR R7<0)
10	IF(OUTLMT(R4,R5,RN(L+9)))GO TO 1
C  IN LIMITS?
	CALL GUPDAT(M,L,9)
5	IF(RY.EQ.2)GO TO 1
	IF(OUTLMT(R4,R5,RN(L+6)))GO TO 1
C  IN LIMITS?
	CALL GUPDAT(M,L,6)
C PUT AWAY POINTER TO P6 FOR ALL 2-SIDED ITEMS.
1	CONTINUE
	END

	SUBROUTINE GUPDAT(M,L,KK)
	COMMON /KJY/ K,J /POSI/STFF(8),JJ2 /RINP/R(500),N(350),NP(250)
	J=J+1
	N(J)=L+KK
C SETS UP POINTERS FOR USE IN MOVES, ETC.
	IF(M.LT.JJ2)JJ2=M
	END

	SUBROUTINE DELETE
	IMPLICIT INTEGER(A-Q,S-Z)
	COMMON/DL/X22,SAVER,NAME /XRN/RN(1)
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(15),R6,DEL,X,JY,K
	COMMON/PTR/PWDS(1) /LIMIT/LIM,ITEM,L,I,IX
	1 /DPY/ST(4000),MEDIT,IGO  /DPTR/WDS(350)
	EQUIVALENCE (ST2,ST(2))
    	IX=I
	L=RN(MEDIT)+3
C  SIZE OF DELETION
	I=IX-L
	CALL LOOP(MEDIT,I,1,0,L,RN)
	JY=WDS(X22+1)-WDS(X22)
	CALL LOOP(WDS(X22)+2,WDS(ITEM),1,0,JY,ST)
	K=X22
194	 N=K+1
	WDS(N)=WDS(N+1)-JY
	PWDS(K)=PWDS(N)-L
	K=N
	IF(K.LT.ITEM)GO TO 194
C  ABOVE RESHUFFLES POINTER ARRAYS. X=ITEM+1
	ITEM=ITEM-1
	IF(X22.GT.ITEM)X22=ITEM
	J2=ITEM
	ITEM=ITEM-1
	ST2=WDS(J2)
271	CALL DPYNEW
	END
 
	SUBROUTINE STFCH
	CALL CPYIT(1)
	END
	SUBROUTINE COPYIT
	CALL CPYIT(0)
	END

	SUBROUTINE CPYIT(KC)
	INTEGER PWDS
	COMMON/XRN/RN(1) /POSI/S(8),JJ2,P
	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
	1/PTR/PWDS(1) /LIMIT/LIM,ITEM,LL,I,IX
 	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
 	1,(R6,RJQ(4))

C KC IS FLAG FOR STFCH ROUTINE
	IM=ITEM
	DO 1 K=1,IM
	L=PWDS(K)
	IF(RTLINE(L))GO TO 1
	IF(OUTLMT(R4,R5,RN(L+3)))GO TO 1
	IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
	IF(KC.NE.0)GO TO 2
	M=RN(L)+2
	CALL LOOP(0,M,1,I,L,RN)
	ITEM=ITEM+1
	L=PWDS(ITEM)
2	IF(R7.LE.7.)RN(L+2)=R7
	IF(KC.EQ.0)GO TO 3
	IF(K.LT.JJ2)JJ2=K
	GO TO 1 
3	IF(ITEM.LT.JJ2)JJ2=ITEM
	I=I+M+1
	PWDS(ITEM+1)=I
 1	CONTINUE
	IF(KC.EQ.0)R2=R7
	END